Waze genera información sobre atascos de tráfico procesando las siguientes fuentes de datos:
Ubicación de GPS enviados de los teléfonos de los usuarios que conducen mientras usan la aplicación, información generada en tiempo real en funciónde la ubicación y velocidad.
Cálculo de velocidad real frente a la velocidad media (en un intervalo de tiempo específico) y flujo libre (velocidad máxima media en el segmento)
Reportes compartidos por los usuarios de Waze que están en un atasco
Descripción de algunas variables utilizadas en este análisis:
Semana actual: del 2022-08-08 00:00:06 al día 2022-08-14
23:58:04
Semana anterior: del 2022-08-01 00:00:06 al día 2022-08-08
00:00:05
| Día | Sem_anterior | Sem_actual | Variación |
|---|---|---|---|
| Domingo | 8501 | 13065 | 53.7 |
| Lunes | 23873 | 22789 | -4.5 |
| Martes | 28321 | 24603 | -13.1 |
| Miercoles | 24963 | 24862 | -0.4 |
| Jueves | 25433 | 27572 | 8.4 |
| Viernes | 33141 | 30826 | -7.0 |
| Sabado | 15160 | 18239 | 20.3 |
| Total | 159392 | 161956 | 1.6 |
---
title: Semana
date: "`r Sys.Date()`"
output:
flexdashboard::flex_dashboard:
theme: sandstone
social: menu
source_code: embed
#orientation: rows
#orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(yaml)
library(knitr)
require(plotly)
library(ggplot2)
require(gganimate)
require(esquisse)
require(gapminder)
library(ggplot2)
library(kableExtra)
library(animation)
##### LIBRERIAS
library(sf)
library(sp)
library(raster)
library(leaflet)
library(tidyverse)
library(ggmap)
library(reshape2)
library(dplyr)
library(spatstat)
library(tmaptools)
library(readr)
#library(gifski)
#library(tibble)
library(lubridate)
library(hms)
library(leaflet.extras)
#library(magrittr)
library(foreign)
library(xtable)
library(base)
library(DT)
#library(data.table)
#library(forecast)
# library(rgdal)
# library(spbabel)
library(maptools)
library(tmap)
library(DT)
library(reshape2)
library(reshape)
```
```{r}
#dat = read.table('datos_app_15dias/datos_app_15dias.csv',sep = ',',header = T)
dat = read.table('waze_15dias.csv',sep = ',',header = T)
#datosapp15
dat = dat %>% filter(city == "Montevideo")
datJam = dat %>% mutate(datecreated = as.POSIXct(strptime(gsub('T',' ',datecreated), "%Y-%m-%d %H:%M:%S")),
datemodified = as.POSIXct(strptime(gsub('T',' ',datemodified), "%Y-%m-%d %H:%M:%S")),
time_index = as.POSIXct(strptime(gsub('T',' ',time_index), "%Y-%m-%d %H:%M:%S")),
datepublished = as.POSIXct(strptime(gsub('T',' ',datepublished), "%Y-%m-%d %H:%M:%S")))
datJam = datJam %>% filter(datemodified>min(datJam$datemodified)+60*60*24)
```
```{r}
df <- datJam %>% dplyr::select(datemodified,street,length,delay,speed,speedkmh,level,location_centroid_lat,location_centroid_lon,datemodified,datecreated)
datJam <- df
```
```{r}
#extrae coordenadas del centroide
datJam$Xc <- datJam$location_centroid_lat
datJam$Yc <- datJam$location_centroid_lon
```
```{r}
#hago las transformaciones para dia hora mes, etc
datJam = datJam %>%
mutate(dia = day(datJam$datemodified),
mes = month(datJam$datemodified),
ano = year(datJam$datemodified),
hora = hour(datJam$datemodified),
NomDia = wday(datJam$datemodified),
MesDia = ifelse(nchar(mes)==2, paste0(mes,'-',dia),paste0('0',mes,'-',dia)),
#DiaMes = ifelse(nchar(mes)==2, paste0(mes,'-',dia),paste0(mes,'-0',dia)),
#DiaMesHora = paste0(DiaMes,'-',hora))
MesDiaHora = ifelse(nchar(hora)==2,paste0(MesDia,'-',hora),paste0(MesDia,'-0',hora)))
# MesDia = ifelse(nchar(datJam$mes)==2, paste0(datJam$mes,'-',datJam$dia),paste0('0',datJam$mes,'-',datJam$dia))
datJam$nombreDia <- ifelse(datJam$NomDia == 1, 'Domingo',
ifelse(datJam$NomDia == 2, 'Lunes',
ifelse(datJam$NomDia == 3, 'Martes',
ifelse(datJam$NomDia == 4, 'Miercoles',
ifelse(datJam$NomDia == 5, 'Jueves',
ifelse(datJam$NomDia == 6, 'Viernes',
ifelse(datJam$NomDia == 7, 'Sabado',0)))))))
datJam$nombreDia <- factor(datJam$nombreDia
,ordered = TRUE,
levels = c("Domingo", "Lunes", "Martes", "Miercoles",'Jueves','Viernes','Sabado'))
datJam = datJam %>%
mutate(NomMesDia = paste0(MesDia ,'-',nombreDia))
#min(datJam$datemodified)
```
```{r}
#trabajo con semanas
undia <- 1*24*60*60
unasemana <- undia*7
sem1 <- datJam %>% filter(datemodified< (min(datJam$datemodified)+unasemana))
sem2 <- datJam %>% filter(datemodified>= (min(datJam$datemodified)+unasemana))
# sem1 <- datJam %>% filter(datemodified > (min(datJam$datemodified) + undia) & (datemodified < min(datJam$datemodified)+unasemana+undia))
#
# sem2 <- datJam %>% filter((datemodified> min(datJam$datemodified)+unasemana+undia) & (datemodified < max(datJam$datemodified)))
datJam$sem <- ifelse(datJam$datemodified < (min(datJam$datemodified)+unasemana),'sem1','sem2')
#datJam <- datJam %>% filter(datemodified > min(datJam$datemodified)+undia)
```
**Descripción**
=======================================================================
Column {data-width=400}
-----------------------------------------------------------------------
### **Descripción**
Waze genera información sobre atascos de tráfico procesando las siguientes fuentes de datos:
- Ubicación de GPS enviados de los teléfonos de los usuarios que conducen mientras usan la aplicación, información generada en tiempo real en funciónde la ubicación y velocidad.
- Cálculo de velocidad real frente a la velocidad media (en un intervalo de tiempo específico) y flujo libre (velocidad máxima media en el segmento)
- Reportes compartidos por los usuarios de Waze que están en un atasco
Descripción de algunas variables utilizadas en este análisis:
- **delay**: Retraso con respecto a un flujo libre en segundos
- **level**: Nivel de atasco (0 a 5, 0 libre y 5 muy congestionado)
- **length**: Largo en metros
- **speedkmh**: Velocidad promedio en kilómetros por hora
**Semana actual: del `r min(sem2$datemodified)` al día `r max(sem2$datemodified)`**
**Semana anterior: del `r min(sem1$datemodified)` al día `r max(sem1$datemodified)`**
Column {data-width=400}
-----------------------------------------------------------------------
### **Cantidad de eventos por día**
```{r}
resumen <- datJam %>%
filter(sem == 'sem2') %>%
group_by(level) %>%
dplyr::summarise(Cant=n())
Total <- sum(resumen$Cant)
resumen2 <- rbind(resumen, c("Total",Total))
#
# resumen1 <- datJam %>%
# filter(sem == 'sem1') %>%
# group_by(level) %>%
# dplyr::summarise(Cant=n())
#
# Total1 <- sum(resumen1$Cant)
#
# resumen1 <- rbind(resumen1, c("Total1",Total1))
#
# resumenT <- datJam %>%
# #filter(sem == 'sem1') %>%
# group_by(level) %>%
# dplyr::summarise(Cant=n())
#
# TotalT <- sum(resumenT$Cant)
#
# resumenT <- rbind(resumenT, c("TotalT",TotalT))
# kable(resumen1) %>%
# kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
```
```{r}
x = sem2 %>%
group_by(NomMesDia) %>%
dplyr::summarise(n_dM=n()) %>%
mutate(prop = round(100*prop.table(n_dM),1)) %>%
ungroup()
#x <- x[x$NomMesDia != '06-2-Jueves',]
evol_md_2 <- ggplot(x) +
aes(x=NomMesDia, y=n_dM) +
geom_bar(stat = "identity", fill="darkgrey") +
theme_minimal()+
theme(legend.position = 'top',
legend.title = element_blank(),
axis.text.x = element_text(angle = 45,hjust = 1,vjust = 1,size = 7)) +
# geom_text(aes(label=n_dM), vjust=0, color="black", #15
# position = position_dodge(0.9), size=2.0
# ) +
# geom_text(aes(label=prop), vjust = 1, color="black", #15
# position = position_dodge(0.9), size=2.0
# ) +
labs(x = "Fecha", y = 'Cantidad de eventos', colour = "Cantidad eventos")
# title = "Congestion diaria por dia de la semana actual (todos los niveles)",
ggplotly(evol_md_2)
```
### **Cantidad de eventos por nivel**
```{r}
x_level = sem2 %>%
group_by(level) %>%
dplyr::summarise(n_dM=n()) %>%
mutate(prop = round(100*prop.table(n_dM),1)) %>%
ungroup()
gg_level <- ggplot(x_level) +
aes(x=level, y=n_dM) +
geom_bar(stat = "identity", fill="darkgrey") +
theme_minimal()+
theme(legend.position = 'top',
legend.title = element_blank(),
axis.text.x = element_text(hjust = 1,vjust = 1,size = 7)) +
labs(x = "Level", y = 'Cantidad de eventos')
ggplotly(gg_level)
```
Column {data-width=500}
-----------------------------------------------------------------------
### **Mapa de calor semana actual**
```{r message=FALSE, warning=FALSE, include=FALSE}
#levanto capa municipios
municipios <- st_read("SHP/sig_municipios/sig_municipios.shp")
#levanto capa de barrios
barrios <- st_read("SHP/barrios.gpkg")
mun = read_sf('SHP/sig_municipios/sig_municipios.shp')
ccz = read_sf('SHP/sig_comunales/sig_comunales.shp')
st_crs(ccz) = st_crs(mun)
#paso a coordenadas lat long
st_geometry(mun) = st_transform(st_geometry(mun), 4326)
st_geometry(ccz) = st_transform(st_geometry(ccz), 4326)
```
```{r message=FALSE, warning=FALSE, include=FALSE}
####### ETIQUETAS MUNICIPIOS
etiqMuni <- paste0("Nombre municipio: ",
mun$MUNICIPIO)
############ EJEMPLO 1 (BASICO)
#defino una variable numérica para cada municipio (del 1 al 8) pa después usarla pa colorearlos
mun$MUNI <- ifelse(mun$MUNICIPIO == 'A', 1,
ifelse(mun$MUNICIPIO == 'B', 2,
ifelse(mun$MUNICIPIO == 'C', 3,
ifelse(mun$MUNICIPIO == 'CH', 4,
ifelse(mun$MUNICIPIO == 'D', 5,
ifelse(mun$MUNICIPIO == 'E', 6,
ifelse(mun$MUNICIPIO == 'F', 7, ifelse(mun$MUNICIPIO == 'G', 8, 0))))))))
###### DEFINO colores
pal <- colorNumeric(
palette = "YlGn",
domain = mun$MUNI)
```
```{r message=FALSE, warning=FALSE, include=FALSE}
#mapa con todos los niveles semana 1
mapa_heat_sem2 <- leaflet() %>% # ABRE LA VENTANA PARA HACER EL MAPA
addTiles(group = "OSM") %>% # DEFINE UN FONDO (POR DEFECTO OSM)
addProviderTiles(providers$CartoDB.Positron, group = 'CartoDB.Positron') %>%
# PONE OTRO FONDO PARA ELEGIR
addPolygons(data=mun, #fillColor = ~pal(mun$MUNI), # AGReGA LA CAPA DE POLIGONAS DE LOS MUNICIPIOS
fillOpacity = 0,
weight = 1, #smoothFactor = 0.2,
popup=etiqMuni,group = 'Municipio') %>%
addHeatmap(lng=sem2$Xc,lat=sem2$Yc,max=100,radius=5,blur=10) %>%#
#addCircles(niv34$Xc, niv34$Yc,radius = 1,group = 'dia',color = "dia") %>% ##AGREGO LAS ESCUELAS PUBLICAS
addLayersControl(
baseGroups = c("CartoDB.Positron","OSM"),
overlayGroups = c("congest","Municipio"), # ESTAS SE PUEDEN PRENDER DE A UNA
options = layersControlOptions(collapsed = FALSE))
#leaflet::addLegend( position = "topright", pal = pal, values = ~mag, group = "Points", title = "Магитуда землетрясений" )
```
```{r}
mapa_heat_sem2
```
**Comparación diaria**
=======================================================================
Column {data-width=700}
-----------------------------------------------------------------------
### **Congestión diaria por hora semana actual vs semana anterior**
```{r}
semt<-datJam %>%
group_by(sem,nombreDia,hora) %>%
dplyr::summarise(Cant=n())
aa_hora_linea1 <- ggplot(semt) +
aes(x = hora, y = Cant, fill = sem) +
geom_bar(stat = 'identity',position = 'dodge',alpha=0.5) +
theme(legend.position = "top") +
#geom_line() +
theme_minimal()+
scale_fill_manual(values=c("dark green","dark orange")) +
facet_grid(nombreDia~.)+
labs(x = "dia_hora", y = 'Cantidad de eventos')
ggplotly(aa_hora_linea1)
```
Column {data-width=300}
-----------------------------------------------------------------------
### **Congestión diaria: variación**
```{r}
#tabla eventos por día y semana
sem_dia<-datJam %>%
group_by(sem,nombreDia) %>%
dplyr::summarise(Cant=n())
aa_hora_linea1 <- ggplot(sem_dia, aes(x = nombreDia, y = Cant, fill = sem)) +
geom_bar(stat = 'identity',position = 'dodge') +
#geom_line() +
theme_minimal()+
#facet_grid(sem~.)+
labs(x = "dia_hora", y = 'Cantidad de eventos', colour = "Cantidad eventos")
#ggplotly(aa_hora_linea1)
cast_sem_dia = cast(sem_dia, nombreDia~sem)
Total <- cast_sem_dia %>%
colSums()
cast_sem_diaT = bind_rows(cast_sem_dia, Total)
cast_sem_diaT$nombreDia <- as.character(cast_sem_diaT$nombreDia)
cast_sem_diaT[(dim(cast_sem_diaT)[1]), 1] = "Total"
#cast_sem_dia$total = cast_sem_dia$sem2+ cast_sem_dia$sem1
cast_sem_diaT$variacion = round(100*(cast_sem_diaT$sem2-cast_sem_diaT$sem1)/cast_sem_diaT$sem1,1)
#rownames(cast_sem_dia) <- NULL
colnames(cast_sem_diaT) <-c("Día","Sem_anterior","Sem_actual","Variación")
kable(cast_sem_diaT) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
```
**Comparación: todos los niveles**
=======================================================================
Column {data-width=300}
-----------------------------------------------------------------------
### **Cantidad de eventos y variación con respecto a las calles más congestionadas la semana anterior**
```{r}
df_aux = datJam %>%
group_by(street,sem) %>%
dplyr::summarise(Cant=n())
#df_aux1 <- df_aux[order(df_aux$Cant, decreasing = TRUE), ]
aa = df_aux %>%
group_by(street) %>%
slice_max(Cant) %>%
arrange(desc(Cant)) %>%
head(40)
bb = df_aux %>% inner_join(aa %>% dplyr::select(street))
cast_data = cast(bb, street~sem, sum)
#cast_data = cast(df_aux, street~sem, sum)
# cast_data$variacion = round(100*(cast_data$sem2-cast_data$sem1)/cast_data$sem1,1)
#
#lo ordeno en funcion de la cantidad de eventos de la semana anterior
varia_calles <- cast_data[order(cast_data$sem1, decreasing = TRUE), ]
#
rownames(varia_calles) <- NULL
#
# kable(head(varia_calles,20)) %>%
# kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
tabla <- cast_data %>%
mutate(variacion = round(100*(sem2-sem1)/sem1,1)) %>%
arrange(desc(sem1)) %>%
head(100) %>%
DT::datatable()
tabla
```
Col
-----------------------------------------------------------------------
### **Comparación calles más congestionadas: todos los niveles **
```{r}
Cant_calles <- 5
calles<-varia_calles[1:Cant_calles,1]
rank1 <- ggplot() +
geom_bar(data = varia_calles, aes(x=reorder(street,sem1), y=sem1),stat = "identity", position = position_dodge(),fill = "dark green",alpha=0.5)+
geom_bar(data = varia_calles, aes(x=street, y=sem2),stat = "identity", position = position_dodge(),alpha=0.4)+
coord_flip() +
theme_minimal()+
labs(x= NULL, y = "Cantidad de eventos") #+
#ggtitle("Ranking de calles más congestionadas según semana anterior")
ggplotly(rank1)
#gg <- ggplotly(rank1, tooltip = c("Street", "Cant"))
#highlight(gg, on = "plotly_click")
##ggplotly por defecto pone en la etiqueta lo que está en aes
#tooltip = c("Calle", "Cantidad") selecciona parte de las etiquetas
```
```{r}
aa_hora_linea <- ggplot(semt, aes(x = hora, y = Cant, color = nombreDia)) +
geom_line() +
theme_minimal()+
facet_grid(sem~.)+
labs(title = "Congestion diaria por hora semana actual vs semana anterior (OTRA VERS)", x = "dia_hora", y = 'Cantidad de eventos', colour = "Cantidad eventos")
#ggplotly(aa_hora_linea)
```
**Comparación: Niveles 3 y 4**
=======================================================================
Column {data-width=300}
-----------------------------------------------------------------------
### **Cantidad de eventos y variación con respecto a las calles más congestionadas la semana anterior**
```{r}
# library(reshape2)
# library(reshape)
df_aux34 = datJam %>%
filter(datJam$level>2) %>%
group_by(street,sem) %>%
dplyr::summarise(Cant=n())
#df_aux1 <- df_aux[order(df_aux$Cant, decreasing = TRUE), ]
aa34 = df_aux34 %>%
group_by(street) %>%
slice_max(Cant) %>%
arrange(desc(Cant)) %>%
head(40)
bb34 = df_aux34 %>% inner_join(aa34 %>% dplyr::select(street))
cast_data34 = cast(bb34, street~sem, sum)
#cast_data = cast(df_aux, street~sem, sum)
# cast_data34$variacion = round(100*(cast_data34$sem2-cast_data34$sem1)/cast_data34$sem1,1)
#
# #lo ordeno en funcion de la cantidad de eventos de la semana anterior
varia_calles34 <- cast_data34[order(cast_data34$sem1, decreasing = TRUE), ]
#
rownames(varia_calles34) <- NULL
# kable(head(varia_calles34,20)) %>%
# kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
tabla34 <- cast_data34 %>%
mutate(variacion = round(100*(sem2-sem1)/sem1,1)) %>%
arrange(desc(sem1)) %>%
head(100) %>%
DT::datatable()
tabla34
# Cant_calles = 5
# varia_calles34 <- tabla34$x$data[[2]]
#
# calles34<-varia_calles34[1:Cant_calles]
#tabla34$x$data[[2]][1]
```
Col
-----------------------------------------------------------------------
### **Comparación calles más congestionadas: niveles 3 y 4**
```{r}
#varia20 <- varia_calles[1:20,]
Cant_calles <- 5
calles34<-varia_calles34[1:Cant_calles,]
rank34 <- ggplot() +
geom_bar(data = varia_calles34, aes(x=reorder(street,sem1), y=sem1),stat = "identity", position = position_dodge(),fill = "dark orange",alpha=0.5)+
geom_bar(data = varia_calles34, aes(x=street, y=sem2),stat = "identity", position = position_dodge(),alpha=0.4)+
coord_flip() +
theme_minimal()+
labs(x= NULL, y = "Cantidad de eventos") #+
#ggtitle("Ranking de calles más congestionadas según semana anterior")
ggplotly(rank34)
```
```{r include=FALSE}
#bb34 = df_aux34 %>% inner_join(aa34 %>% dplyr::select(street))
#tt = datJam %>% inner_join(varia_calles34 %>% dplyr::select(street))
desc_sem2 <- datJam %>%
inner_join(calles34 %>% dplyr::select(street)) %>%
filter(sem == 'sem2') %>%
group_by(street,nombreDia,hora) %>%
dplyr::summarise(Cant=n())
semt<-datJam %>%
group_by(sem,nombreDia,hora) %>%
dplyr::summarise(Cant=n())
d_h34 <- ggplot(desc_sem2) +
aes(x = hora, y = Cant, fill = street) +
geom_bar(stat = 'identity',position = 'dodge') +
#geom_line() +
theme_minimal()+
facet_grid(nombreDia~.)+
labs(title = "Congestion diaria por hora semana actual vs semana anterior (OTRA VERS)", x = "dia_hora", y = 'Cantidad de eventos', colour = "Cantidad eventos")
calle_linea <- ggplot(desc_sem2) +
aes(x = hora, y = Cant, group=street, color= street) +
geom_line() +
scale_color_brewer(palette="Accent")+
theme_minimal()+
facet_grid(nombreDia~.)+
#theme(legend.position = "top") +
labs(x = "Hora", y = 'Cantidad de eventos')
#ggplotly(d_h34)
#ggplotly(calle_linea)
fig <- ggplotly(calle_linea)
# fig <- a %>% layout(legend = list(orientation = 'h')) %>%
# layout(legend= list(itemsizing='constant'))
#legendOptions(position = c('topleft'))
```
```{r}
pp2 <- datJam %>%
inner_join(calles34 %>% dplyr::select(street)) %>%
filter(sem == 'sem2') %>%
group_by(street,level,length,speedkmh,delay) %>%
ungroup() %>%
group_by(street) %>%
dplyr::summarise(Cant=n(),
Media_d= round(mean(delay),0),
q10_d = quantile(delay, prob=c(0.10)),
q90_d = quantile(delay, prob=c(0.90)),
Media_vel= round(mean(speedkmh),0),
q10_vel = round(quantile(speedkmh, prob=c(0.10)),0),
q90_vel = round(quantile(speedkmh, prob=c(0.90)),0),
Media_len= round(mean(length),0),
q10_len = quantile(length, prob=c(0.10)),
q90_len = quantile(length, prob=c(0.90)))
fig_delay<- ggplot(pp2) +
aes(x=street, y=Media_d) +
#geom_line() +
geom_point(colour="darkgreen",size = 3)+
geom_errorbar(aes(ymin=q10_d, ymax=q90_d), width=.2,
position=position_dodge(0.05)) +
coord_flip() +
theme_minimal()+
labs(x= NULL, y = NULL)
fig_vel<- ggplot(pp2) +
aes(x=street, y=Media_vel) +
#geom_line() +
geom_point(colour="darkorange",size = 3)+
geom_errorbar(aes(ymin=q10_vel, ymax=q90_vel), width=.2,
position=position_dodge(0.05)) +
coord_flip() +
theme_minimal()+
labs(x= NULL, y = NULL)
fig_len<- ggplot(pp2) +
aes(x=street, y=Media_len) +
#geom_line() +
geom_point(colour="darkgrey",size = 3)+
geom_errorbar(aes(ymin=q10_len, ymax=q90_len), width=.2,
position=position_dodge(0.05)) +
coord_flip() +
theme_minimal()+
labs(x= NULL, y = NULL)
pp3 <- datJam %>%
inner_join(calles34 %>% dplyr::select(street)) %>%
filter(sem == 'sem2') %>%
group_by(street,level) %>%
dplyr::summarise(Cant=n())
fig_nivel<- ggplot(pp3) +
aes(x=level, y=Cant, fill=street) +
geom_bar(stat = 'identity',position = 'dodge')+
theme_minimal()+
#coord_flip() +
labs(title='Cantidad de eventos por nivel', x = "level", colour = "Cantidad eventos")
#ggplotly(fig_delay)
```
**Calles más congestionadas**
=======================================================================
Column {data-width=700}
-----------------------------------------------------------------------
### **Eventos por día y hora de las 5 calles más congestionadas la semana anterior con niveles 3 y 4**
```{r}
fig
```
Column {data-width=300}
-----------------------------------------------------------------------
### Delay en segundos
```{r}
ggplotly(fig_delay)
```
### Velocidad en Km/h
```{r}
ggplotly(fig_vel)
```
### Largo en metros
```{r}
ggplotly(fig_len)
```